home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / gfx / conv / r2g.lha / R2G.mod < prev   
Text File  |  1992-10-11  |  6KB  |  202 lines
  1. (************************************************************************************
  2.  * Programm : R2G                                                                   *
  3.  * Version  : 1.11                                                                  *
  4.  * Lenght   : 14324                                                                 *
  5.  *                                                                                  *
  6.  * Datum    : 10.10.92                                                              *
  7.  * Autor    : Jürgen Bernd                                                          *
  8.  * Compiler : AmigaOberon 2.13D                                                     *
  9.  *                                                                                  *
  10.  * Funktion : Dieses Programm ermöglicht es ein 2-Farb-Rasterbild (Zeitungsdruck)   *
  11.  *            in ein echtes 16-Graustufen-Bild zu konvertieren. Dies geschieht im   *
  12.  *            im Gegensatz zu WASP2.02B ohne Größenverlust.                         *
  13.  ************************************************************************************)
  14.  
  15. MODULE R2G;
  16.  
  17. IMPORT
  18.   S : SYSTEM,
  19.   G : Graphics,
  20.   Is : IFFSupport,
  21.   I : Intuition,
  22.   N : NoGuru,
  23.   A : Arguments;
  24.  
  25. VAR
  26.   Count : INTEGER;
  27.   OldSP,NewSP : I.ScreenPtr;
  28.   OldRP : G.RastPortPtr;
  29.   wp : I.WindowPtr;
  30.   Name : ARRAY 20 OF CHAR;
  31.   Buffer : ARRAY 640 OF BYTE;
  32.  
  33. PROCEDURE OpenNewScreen();
  34. VAR
  35.   k : INTEGER;
  36.   MyS : I.NewScreen;
  37.   VP : G.ViewPortPtr;
  38. BEGIN
  39.   MyS.leftEdge := 0;
  40.   MyS.topEdge := 0;
  41.   MyS.width := OldSP^.width;
  42.   MyS.height := OldSP^.height;
  43.   MyS.depth := 4;
  44.   MyS.detailPen := 7;
  45.   MyS.blockPen := 0;
  46.   MyS.viewModes := OldSP^.viewPort.modes;
  47.   MyS.type := {};
  48.   MyS.font := NIL;
  49.   MyS.defaultTitle := NIL;
  50.   MyS.gadgets := NIL;
  51.   MyS.customBitMap := NIL;
  52.   NewSP := I.OpenScreen(MyS);
  53.   N.Assert(NewSP#NIL,"ERROR : can't open screen");
  54.   VP := S.ADR(NewSP^.viewPort);
  55.   k := 0;
  56.   WHILE k<16 DO
  57.     G.SetRGB4(VP,k,k,k,k);
  58.     INC(k);
  59.   END;
  60. END OpenNewScreen;
  61.  
  62. PROCEDURE GetColor1(x,y : INTEGER) : INTEGER;
  63. VAR
  64.   Color : LONGINT;
  65. BEGIN
  66.   Color := 0;
  67.   INC(Color,G.ReadPixel(OldRP,x-1,y-1));
  68.   INC(Color,G.ReadPixel(OldRP,x-1,y));
  69.   INC(Color,G.ReadPixel(OldRP,x-1,y+1));
  70.   INC(Color,G.ReadPixel(OldRP,x,y-1));
  71.   INC(Color,G.ReadPixel(OldRP,x,y));
  72.   INC(Color,G.ReadPixel(OldRP,x,y+1));
  73.   INC(Color,G.ReadPixel(OldRP,x+1,y-1));
  74.   INC(Color,G.ReadPixel(OldRP,x+1,y));
  75.   INC(Color,G.ReadPixel(OldRP,x+1,y+1));
  76.   INC(Color,G.ReadPixel(OldRP,x,y-2));
  77.   INC(Color,G.ReadPixel(OldRP,x,y+2));
  78.   INC(Color,G.ReadPixel(OldRP,x+2,y));
  79.   INC(Color,G.ReadPixel(OldRP,x-2,y));
  80.   INC(Color,G.ReadPixel(OldRP,x+2,y-1));
  81.   INC(Color,G.ReadPixel(OldRP,x+2,y+1));
  82.   RETURN SHORT(Color);
  83. END GetColor1;
  84.  
  85. PROCEDURE GetColor2(x,y : INTEGER) : INTEGER;
  86. VAR
  87.   Color,Result : LONGINT;
  88. BEGIN
  89.   Color := 0;
  90.   INC(Color,G.ReadPixel(OldRP,x-1,y-1));
  91.   INC(Color,G.ReadPixel(OldRP,x-1,y));
  92.   INC(Color,G.ReadPixel(OldRP,x-1,y+1));
  93.   INC(Color,G.ReadPixel(OldRP,x,y-1));
  94.   INC(Color,G.ReadPixel(OldRP,x,y));
  95.   INC(Color,G.ReadPixel(OldRP,x,y+1));
  96.   INC(Color,G.ReadPixel(OldRP,x+1,y-1));
  97.   INC(Color,G.ReadPixel(OldRP,x+1,y));
  98.   INC(Color,G.ReadPixel(OldRP,x+1,y+1));
  99.   Result := Color*3;
  100.   Color := 0;
  101.   INC(Color,G.ReadPixel(OldRP,x,y-2));
  102.   INC(Color,G.ReadPixel(OldRP,x,y+2));
  103.   INC(Color,G.ReadPixel(OldRP,x+2,y));
  104.   INC(Color,G.ReadPixel(OldRP,x-2,y));
  105.   INC(Color,G.ReadPixel(OldRP,x+2,y-1));
  106.   INC(Color,G.ReadPixel(OldRP,x+2,y+1));
  107.   INC(Color,G.ReadPixel(OldRP,x-2,y-2));
  108.   INC(Color,G.ReadPixel(OldRP,x-1,y-2));
  109.   INC(Color,G.ReadPixel(OldRP,x+1,y-2));
  110.   INC(Color,G.ReadPixel(OldRP,x+2,y-2));
  111.   INC(Color,G.ReadPixel(OldRP,x-2,y-1));
  112.   INC(Color,G.ReadPixel(OldRP,x-2,y+1));
  113.   INC(Color,G.ReadPixel(OldRP,x-2,y+2));
  114.   INC(Color,G.ReadPixel(OldRP,x-1,y+2));
  115.   INC(Color,G.ReadPixel(OldRP,x+1,y+2));
  116.   INC(Color,G.ReadPixel(OldRP,x+2,y+2));
  117.   INC(Result,Color*2);
  118.   INC(Result,G.ReadPixel(OldRP,x-3,y-3));
  119.   INC(Result,G.ReadPixel(OldRP,x-2,y-3));
  120.   INC(Result,G.ReadPixel(OldRP,x-1,y-3));
  121.   INC(Result,G.ReadPixel(OldRP,x,y-3));
  122.   INC(Result,G.ReadPixel(OldRP,x+1,y-3));
  123.   INC(Result,G.ReadPixel(OldRP,x+2,y-3));
  124.   INC(Result,G.ReadPixel(OldRP,x+3,y-3));
  125.   INC(Result,G.ReadPixel(OldRP,x-3,y-2));
  126.   INC(Result,G.ReadPixel(OldRP,x+3,y-2));
  127.   INC(Result,G.ReadPixel(OldRP,x-3,y-1));
  128.   INC(Result,G.ReadPixel(OldRP,x+3,y-1));
  129.   INC(Result,G.ReadPixel(OldRP,x-3,y));
  130.   INC(Result,G.ReadPixel(OldRP,x+3,y));
  131.   INC(Result,G.ReadPixel(OldRP,x+3,y+1));
  132.   INC(Result,G.ReadPixel(OldRP,x-3,y+1));
  133.   INC(Result,G.ReadPixel(OldRP,x-3,y+2));
  134.   INC(Result,G.ReadPixel(OldRP,x+3,y+2));
  135.   INC(Result,G.ReadPixel(OldRP,x-3,y+3));
  136.   INC(Result,G.ReadPixel(OldRP,x-2,y+3));
  137.   INC(Result,G.ReadPixel(OldRP,x-1,y+3));
  138.   INC(Result,G.ReadPixel(OldRP,x,y+3));
  139.   INC(Result,G.ReadPixel(OldRP,x+1,y+3));
  140.   INC(Result,G.ReadPixel(OldRP,x+2,y+3));
  141.   INC(Result,G.ReadPixel(OldRP,x+3,y+3));
  142.   RETURN SHORT(Result DIV 5);
  143. END GetColor2;
  144.  
  145. PROCEDURE ConvertPic();
  146. VAR
  147.   MaxX,MaxY,x,y : INTEGER;
  148.   NewRP : G.RastPortPtr;
  149.   Dummy : BOOLEAN;
  150. BEGIN
  151.   OpenNewScreen();
  152.   MaxX := OldSP^.width-3;
  153.   MaxY := OldSP^.height-3;
  154.   OldRP := S.ADR(OldSP^.rastPort);
  155.   NewRP := S.ADR(NewSP^.rastPort);
  156.   IF Count=2 THEN
  157.     y := 2;
  158.     WHILE y<=MaxY DO
  159.       x := 2;
  160.       WHILE x<=MaxX DO
  161.         G.SetAPen(NewRP,GetColor1(x,y));
  162.         Dummy := G.WritePixel(NewRP,x,y);
  163.         INC(x);
  164.       END;
  165.       INC(y);
  166.     END;
  167.   ELSE
  168.     y := 3;
  169.     WHILE y<MaxY DO
  170.       x := 3;
  171.       WHILE x<MaxX DO
  172.         G.SetAPen(NewRP,GetColor2(x,y));
  173.         Dummy := G.WritePixel(NewRP,x,y);
  174.         INC(x);
  175.       END;
  176.       INC(y);
  177.     END;
  178.   END;
  179. END ConvertPic;
  180.  
  181. PROCEDURE CleanUp();
  182. BEGIN
  183.   IF OldSP#NIL THEN
  184.     I.OldCloseScreen(OldSP);
  185.   END;
  186.   IF NewSP#NIL THEN
  187.     I.OldCloseScreen(NewSP);
  188.   END;
  189. END CleanUp;
  190.  
  191. BEGIN
  192.   Count := A.NumArgs();
  193.   N.Assert((Count=2) OR (Count=3),"SYNTAX : M2G [inputfile] [outputfile] <HIGH>");
  194.   A.GetArg(1,Name);
  195.   N.Assert(Is.ReadILBM(Name,{Is.front},OldSP,wp)=TRUE,"ERROR : can't load picture");
  196.   ConvertPic();
  197.   A.GetArg(2,Name);
  198.   N.Assert(Is.WriteILBMScreen(Name,NewSP,NIL,TRUE)=TRUE,"ERROR : can't save picture");
  199. CLOSE
  200.   CleanUp();
  201. END R2G.
  202.